home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 2620A.ZIP / APLIB.ZIP / BOXES-U.BAS < prev    next >
BASIC Source File  |  1990-11-23  |  10KB  |  271 lines
  1.  
  2.  
  3.  
  4. '==============================================================================
  5. '                         ALL-PURPOSE LIBARY
  6. '
  7. '                    THE FOURTH UNIT -- BOXES-U.BAS
  8. '==============================================================================
  9. '                                                               -- 2-18-90
  10. '                                                                  H Ballinger
  11.                             $COMPILE UNIT
  12.                             $ERROR ALL OFF
  13.  
  14.  
  15.  DEFINT A-Z
  16.  %Center = 0
  17.  
  18.  EXTERNAL RD$, ColorDisplay, NeedDCon, FlashBox
  19.  EXTERNAL BoxColor, FldColor, WinColor, CursorTop, CursorBottom, Ln, Col
  20.  EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
  21.  EXTERNAL LocalAreaCode$, Record%
  22.  EXTERNAL BXScreenSaved, PMScreenSaved
  23.  EXTERNAL FieldName$(), FieldMask$(), FL(), FC(), Fields%
  24.  
  25.  
  26. SUB BOXMESSAGE(CornerLin, CornerCol, Margin) PUBLIC
  27. '   ====                   Boxes and displays your message.
  28. '                          Top L. corner will be at the designated coordinates,
  29. '                          but errors are trapped so box will stay on the
  30. '                          screen regardless. The message line should appear
  31. '                          in your code as DATA statements, terminated by
  32. '                          "END". A RESTORE statement is needed, of course.
  33. '                          See HBDEMO.BAS for examples & comments.
  34.  
  35.  LOCAL I$(), MaxL, Items%, D$
  36.  
  37.   LOCATE ,,0 '                                           extinguish the cursor
  38. BReadlines:
  39.  DIM I$(23)                      ' each I$ is a msg line; # of lines is Items%
  40.  READ D$
  41.  WHILE D$ <> "END" AND Items% < 23 '                          (from data list)
  42.    INCR Items% '                                                 count 1 item
  43.    I$(Items%) = D$ '                                   plug the data into array
  44.    IF LEN(D$) > MaxL THEN MaxL = LEN(D$)  '         MaxL = length of longest I$()
  45.    READ D$ '                                                    ... and repeat.
  46.    WEND
  47.  
  48.           CALL BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(), Items%, MaxL)
  49.  END SUB                                                         REM BOXMESSAGE
  50. '______________________________________________________________________________
  51.  
  52. SUB BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(1), Items%, MaxL) PUBLIC
  53.  
  54. '    Use this call if you wish to set text lines -- I$() -- at runtime instead
  55. '    of using DATA statements ...
  56.  
  57.  LOCAL Wid, Height, I, P, Y, Z, F, Bar$
  58.  
  59. BSetVars:
  60.  Items% = MIN (Items%, 23) '                  can't contain > 23 limes of text.
  61.  Margin = MIN ((23 - Items%) / 2, Margin) '    if margin too big, reduce.
  62.  
  63.  Wid = MaxL + 4 + 4*Margin '        Total width of box: length of longest text
  64.  '                                  string + 2 for sides, 4 for spaces, and 4
  65.  '                                  for each unit of margin (2 each side).
  66.  
  67.  Items% = MIN (Items%, 23)
  68.  Margin = MIN ((23 - Items%) / 2, Margin)
  69.  
  70.  Height = Items% + 2 + 2*Margin '     Height: add 2 for each unit of margin
  71.  Wid = MIN (Wid, 80)
  72.  Height = MIN (Height, 25)
  73.  
  74.  IF CornerCol = %Center THEN CornerCol = 41 - Wid / 2  '  horiz centering ...
  75.  
  76.  CornerCol = MIN (CornerCol, 81 - Wid) '       If CornerCol + Wid > 80, fix it.
  77.  
  78.  CornerCol = MAX (CornerCol, 1) '                            CornerCol not < 1.
  79.  
  80.  
  81.  IF CornerLin = %Center THEN CornerLin = 13 - Height / 2
  82.  
  83.  CornerLin = MIN (CornerLin, 26-Height)
  84.  
  85.  CornerLin = MAX (1, CornerLin)
  86. '                                             error traps keep box on screen
  87.  
  88.  Bar$ = "\"+SPACE$(Wid-4)+"\" '                                 set a line mask
  89.  
  90. BPrint:
  91.  LOCATE CornerLin, CornerCol
  92.  I = BoxColor MOD 16
  93.  P = BoxColor \ 16 '                 set local variables for colors and
  94.  F = FlashBox * -16 '                  if box to flash, let F = 16
  95.  COLOR  I + F ,  P
  96.  '                                                                print top bar
  97.  PRINT CHR$(201);: PRINT STRING$ ((Wid-2), 205);: PRINT CHR$ (187);
  98.  Z = CornerLin+1
  99.  
  100. IF Margin > 0 THEN
  101.   FOR Y = 1 TO Margin
  102.     LOCATE Z ,CornerCol
  103.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  104.     PRINT USING Bar$;" ";
  105.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  106.     INCR Z
  107.   NEXT
  108. END IF
  109.  '
  110.                                       ' print message lines
  111.  FOR Y = 1 TO Items%
  112.    LOCATE Z,CornerCol
  113.    COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P '  print border char.
  114.    PRINT USING BAR$; SPACE$(2*Margin + (MaxL-Len(I$(Y))) / 2 + .9) + I$(Y);
  115. '          count off enough spaces to center the characters then print 'em ...
  116.    COLOR  I + F ,  P : PRINT CHR$(186); '    and print right hand border.
  117.    INCR Z
  118.  NEXT
  119.  
  120.  IF Margin THEN '                print appropriate # of blank lines for margin
  121.    FOR Y = 1 TO Margin
  122.     LOCATE Z,CornerCol
  123.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  124.     PRINT USING Bar$;" ";
  125.     INCR Z
  126.     COLOR  I + F ,  P : PRINT CHR$(186);
  127.    NEXT
  128.  END IF
  129.  '                                                             print bottom bar
  130.  LOCATE Z, CornerCol, 1: PRINT CHR$ (200);: PRINT STRING$ ((Wid-2), 205);
  131.    PRINT CHR$(188);
  132.  COLOR  I ,  P
  133.  FlashBox = 0
  134.  
  135.  
  136.  END SUB                                                        REM BOXMESSAGE2
  137.  
  138. ' =============================================================================
  139.  
  140.  
  141. SUB POPWINDOW  PUBLIC                         ' print a data entry window ...
  142. '                                                and set up its lookup table
  143.  
  144.  LOCAL X, Y, Z, Title$, CornerCol, CornerLin, Prompt$, Ht, A$
  145.  COLOR WinColor MOD 16, WinColor \ 16
  146.  READ A$: Wid = VAL(A$)
  147.  READ A$: CornerLin = VAL(A$)
  148.  READ A$: CornerCol = VAL(A$)
  149.  READ A$: Ht = VAL(A$)
  150. '                                                       print top of window ...
  151.  LOCATE CornerLin, CornerCol: PRINT CHR$(201);
  152.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(187);
  153.  
  154.  FOR Z = CornerLin+1 TO CornerLin+Ht-2 '                              sides ...
  155.     LOCATE Z, CornerCol: PRINT CHR$(186);SPACE$(Wid-2); CHR$(186);
  156.  NEXT Z
  157.  '                                                  ... print bottom bar.
  158.  LOCATE Z, CornerCol:PRINT CHR$(200);
  159.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(188);
  160.  
  161.   READ Prompt$, X, Y '               place prompts in window (you hope ...)
  162.  DO
  163.   LOCATE X, Y: PRINT Prompt$
  164.   READ Prompt$: IF Prompt$ <> "END" THEN READ X, Y
  165.  LOOP UNTIL Prompt$ = "END"
  166.  
  167.  COLOR FldColor MOD 16, FldColor \ 16
  168.  
  169.  Z=1
  170.  
  171.  READ FieldName$(Z),FieldMask$(Z),FL(Z),FC(Z) '      create the table for
  172. '                                                      this record data window
  173.  DO
  174.    LOCATE FL(Z),FC(Z)
  175.    PRINT SPACE$ (LEN(FieldMask$(Z))) '                 print a blank field ...
  176.   INCR Z
  177.   READ FieldName$(Z)
  178.   IF FieldName$(Z) <> "END" THEN READ FieldMask$(Z), FL(Z), FC(Z)
  179.  LOOP UNTIL FieldName$(Z) = "END"
  180.  
  181.  
  182.  Fields% = Z-1
  183.  
  184.  END SUB
  185.  
  186. ' ----------------------------------------------------------------------------
  187.  
  188.  
  189. SUB PWSetUp (Fld$,Z) PUBLIC    ' sets up to ENTER a record field at the right
  190. '                         location in a pop-up data record window using the
  191. '                         lookup table (FieldName$() etc.). When a match is
  192. '                         found the cursor is placed. The subscript # used
  193. '                         is returned as the parameter Z.
  194.  
  195.  Z = 1
  196.  
  197.  DO UNTIL FieldName$(Z) = Fld$                         'find fld name in table
  198.   INCR Z
  199.   IF Z > Fields% THEN
  200.      BEEP
  201.      LOCATE 25,1
  202.      PRINT "            PWSetUp error: window for "+Fld$+" not open !!!          "
  203.      DO: LOOP UNTIL INKEY$ <> ""
  204.      END 1
  205.   END IF
  206.  LOOP
  207.  
  208.  LOCATE FL(Z), FC(Z)
  209.  COLOR FldColor MOD 16, FldColor \ 16
  210.  
  211.  END SUB                                                REM PWSetUp
  212.  
  213. ' =========================================================================
  214.  
  215. SUB QBOX (L%, C%, Lines%, Message$, AnsFldLength) PUBLIC
  216.  
  217.   LOCAL I$(), AFCol, AFLin, Items, MaxL
  218.   DIM I$(4)
  219.   AnsFldLength = MIN (AnsFldLength, 75) '           trim excessive ans length
  220.  
  221.   IF Lines% > 1 THEN
  222. '                                 THREE LINE Q-BOX
  223.     IF L = %Center THEN L = 11
  224.     L = MIN (L, 21)
  225.     Message$ = LEFT$ (Message$, 76) '  trim excessive prompt
  226.     I$(1) = Message$
  227.     Items% = 3
  228.     I$(2) = " "
  229.     I$(3) = " "
  230.     MaxL = MAX (LEN (Message$), AnsFldLength)
  231.     IF C = %Center THEN C = FIX ((76 - MaxL) / 2)
  232.     C = MIN (C, 76 - MaxL)
  233.     AFCol = C + 2
  234.     IF LEN(Message$) > AnsFldLength THEN
  235.       AFCol = C + 2 + (LEN(Message$)-AnsFldLength)/2
  236.     END IF
  237.     AFLin = L + 3
  238.  
  239.   ELSE
  240. '                             ONE LINE Q-BOX:
  241. '                                      if it's all too long, trim prompt ...
  242.     Message$ = LEFT$ (Message$, 75 - AnsFldLength)
  243.     IF C = %Center THEN C = (80 - LEN (Message$) - AnsFldLength) / 2
  244.     IF L = %Center THEN L = 12
  245.     I$(1) = Message$ + SPACE$ (AnsFldLength + 1)
  246.     Items% = 1
  247. '                                  if C + box width > 80, decrease it to fit
  248.     C = MIN (C, 76 - LEN(Message$) - AnsFldLength)
  249.     AFCol = C + 3 + LEN (Message$)
  250.     AFLin = MIN (L+1, 24)
  251.     MaxL = LEN(Message$) + AnsFldLength + 1
  252.  
  253.   END IF
  254.  
  255.       CALL BOXMESSAGE2 (L,C,0,I$(),Items%,MaxL)
  256.  
  257.   LOCATE AFLin,AFCol,1
  258.   END SUB
  259.  
  260.     '  exit with cursor set correctly at the end of the prompt$ so you
  261.     '   can immediately call a keyboard input routine like those in FENTRY-U.
  262.  
  263. ' --------------------------------------------------------------------------
  264. SUB Marker2 (Z$)
  265.   LOCAL L, C
  266.   L = CSRLIN: C = POS
  267.   LOCATE 1,1: PRINT ">>>>>>> "; Z$; " <<<<<<<<"
  268.   DO: LOOP UNTIL INKEY$ <> ""
  269.   LOCATE L,C
  270. END SUB
  271.